home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / System source / BasicStr < prev    next >
Text File  |  1993-05-13  |  2KB  |  62 lines
  1. \ basicStr - the primitive string class
  2. \  1/14/85  cbd Separated from string
  3. \  9/12/86  cdn Allow zero for addr1 and/or addr2 in replace:
  4. \ 12/04/88    rfl fixed add: using size: self
  5. \ 12/17/92    rfl    lock handle for printing
  6. \  5/13/93    rfl    restore original state after printing; added saving state to replace:
  7.  
  8. Decimal
  9.  
  10. :CLASS  BasicStr  <Super Handle
  11.  
  12.     Var    offset
  13.  
  14.     \ this method returns the handle - replaces get: in super
  15.     :M  HANDLE:  get: super  ;M
  16.  
  17.     \ interface method to the Toolbox Munger utility - 1 replaced by 2
  18.     :M  REPLACE: { addr1 len1 addr2 len2 -- }  getState: self unlock: self
  19.         0 get: super get: offset dup 0< classErr" 151
  20.         addr1 dup IF +base THEN len1 addr2 dup IF +base THEN len2
  21.         $ a9e0 trap ( call Munger ) put: offset  setState: self ;M
  22.  
  23.     \ allocate the string on the heap
  24.     :M  NEW:  0 new: super  clear: offset  ;M
  25.  
  26.     \ set the string to the null string
  27.     :M  CLEAR:  0 setSize: self  clear: offset  ;M
  28.  
  29.     \ ( offs -- ) set new offset for string
  30.     :M  MOVETO:  size: self  min put: offset  ;M
  31.  
  32.     \ ( -- addr len )  return the entire string
  33.     :M  GET:  ptr: self size: self  ;M
  34.  
  35.     \ ( -- addr len )  map string to upper case and get it
  36.     :M  UC:  get: self over +base over >uc   ;M
  37.  
  38.     \ ( addr len -- )  replace entire string with replacement string
  39.     :M  PUT: { addr len -- }   clear: offset
  40.         0 -1 addr len replace: self   ;M
  41.  
  42.     :M  INSERT:  { addr len -- }  addr 0 addr len  replace: self  ;M
  43.  
  44.     :M  ADD: { addr len -- }  size: self moveto: self
  45.         addr len  insert: self ;M
  46.  
  47.     \ ( char -- )  append a char to end of string
  48.     :M  +:  pad c! pad 1 add: self  ;M
  49.  
  50.     \ ( -- chr t OR f)  return char at offset and advance - false if at end
  51.     :M  NEXT:  get: offset size: self <
  52.         IF  get: offset ptr: self + c@ true 1 +: offset
  53.         ELSE  false
  54.         THEN   ;M
  55.  
  56.     \ ( -- )
  57.     :M  PRINT:  getState: self lock: self get:  self type setState: self ;M
  58.  
  59. ;CLASS
  60.  
  61. <" String
  62.